Optional Draw-surfaces.f

Requires OpenGL
Requires Sora
Requires GL-Tools
Requires Tools

Only Forth Definitions

create tcoords-X  0 h, 0 h,   1 h, 0 h,   1 h, 1 h,   0 h, 1 h,
create tcoords100%   0 h, 0 h,   1 h, 0 h,   1 h, 1 h,   0 h, 1 h,

0 value tcoords

: texrect  ( w h color -- )
   gl-texture gl-enable
   draw-color
   unbind-vbo
   glTexCoordPointer( 2 GL_SHORT 0 tcoords )
   true 0 0 enable-tnc
   1 drawarray.[].@ dup 3 drawarray.[].!   + dup  5 drawarray.[].! 7 drawarray.[].!
   drawarray.@ dup 6 drawarray.[].!   + dup 2 drawarray.[].! 4  drawarray.[].!
   drawarray GL_SHORT 4 GL_QUADS draw-arrays2d ;

: texbounds  ( x1 y1 x2 y2 -- )
   locals| y2 x2 y1 x1 |
   tcoords-X x1 w!+ y1 w!+  x2 w!+ y1 w!+  x2 w!+ y2 w!+  x1 w!+ y2 w!+  drop
   tcoords-X to tcoords ;

: texarea  ( x y w h -- )
   area texbounds ;

: tex100%  ( -- )
   tm-identity   tcoords100% to tcoords ;

\ SLOW!
method: surface.draw-part  ( x y w h -- )
   2dup  2>r  texarea
   power/2   dims  1  1  2swap  texgran
   maketex  dup  texture.bind  2r>  white  texrect   texture.destroy
   destroy  ;

\ SLOW!
: surface.draw ( surface -- )
   0 0 third dims draw-part ;
\   sdl-power/2 dup
\   tex100%   dup >r sdl-texture dup bind-texture r> sdl-dims white texrect   delete-texture
\   sdl-destroy ;

{
\ medium speed
: draw-tile  ( n tileset color -- )
   -rot
   dup ->image @ locals| img ts n |
   ts ->tilew 2v@  img  bind-image-texture
   img image@width ts ->tilew @ /  >r
   n r@ mod  n r> /  1  1  texarea
   ts ->tilew 2v@  rot  texrect
   ;
}

{
: tileset.tilexy
   << image.@.width  tilew.@  /  >r
   ( n ) dup  r@ mod  swap r> / >> ;

: tileset.drawtile  ( n color tileset -- )
   << tilew.2@  image.@.bindtex
      ( n ) tilexy  1  1  texarea
      tilew.2@  rot  texrect >> ;
}

{
\ typed version

   dup ->image @ locals| img ts n |
   ts ->tilew 2v@  img  bind-image-texture
   img image@width ts ->tilew @ /  >r
   n r@ mod  n r> /  1  1  texarea
   ts ->tilew 2v@  rot  texrect
   ;

}

\ medium speed
: image.draw-part  ( image x y w h -- )
   2dup  2>r   texarea
   bind  2r>  white  texrect  ;

\ medium speed
: image.draw  ( image -- )
   0  0  third  image-w.2@  draw-part  ;


